home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / events.el.z / events.el
Encoding:
Text File  |  1998-05-21  |  5.4 KB  |  155 lines
  1. ;;; events.el --- event functions.
  2.  
  3. ;;;; Copyright (C) 1996 Ben Wing.
  4.  
  5. ;; Maintainer: Martin Buchholz
  6. ;; Keywords: internal event
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  22. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Synched up with: Not in FSF.
  26.  
  27. ;;; Code:
  28.  
  29.  
  30. (defun event-console (event)
  31.   "Return the console that EVENT occurred on.
  32. This will be nil for some types of events (e.g. eval events)."
  33.   (cdfw-console (event-channel event)))
  34.  
  35. (defun event-device (event)
  36.   "Return the device that EVENT occurred on.
  37. This will be nil for some types of events (e.g. keyboard and eval events)."
  38.   (dfw-device (event-channel event)))
  39.  
  40. (defun event-frame (event)
  41.   "Return the frame that EVENT occurred on.
  42. This will be nil for some types of events (e.g. keyboard and eval events)."
  43.   (fw-frame (event-channel event)))
  44.  
  45. (defun event-buffer (event)
  46.   "Return the buffer of the window over which mouse event EVENT occurred.
  47. Return nil unless both (mouse-event-p EVENT) and
  48. (event-over-text-area-p EVENT) are non-nil."
  49.   (let ((window (event-window event)))
  50.     (and (windowp window) (window-buffer window))))
  51.  
  52. (defalias 'allocate-event 'make-event)
  53.  
  54.  
  55. (defun key-press-event-p (object)
  56.   "Return t if OBJECT is a key-press event."
  57.   (and (event-live-p object) (eq 'key-press (event-type object))))
  58.  
  59. (defun button-press-event-p (object)
  60.   "Return t if OBJECT is a mouse button-press event."
  61.   (and (event-live-p object) (eq 'button-press (event-type object))))
  62.  
  63. (defun button-release-event-p (object)
  64.   "Return t if OBJECT is a mouse button-release event."
  65.   (and (event-live-p object) (eq 'button-release (event-type object))))
  66.  
  67. (defun button-event-p (object)
  68.   "Return t if OBJECT is a mouse button-press or button-release event."
  69.   (and (event-live-p object)
  70.        (memq (event-type object) '(button-press button-release))
  71.        t))
  72.  
  73. (defun motion-event-p (object)
  74.   "Return t if OBJECT is a mouse motion event."
  75.   (and (event-live-p object) (eq 'motion (event-type object))))
  76.  
  77. (defun mouse-event-p (object)
  78.   "Return t if OBJECT is a mouse button-press, button-release or motion event."
  79.   (and (event-live-p object)
  80.        (memq (event-type object) '(button-press button-release motion))
  81.        t))
  82.  
  83. (defun process-event-p (object)
  84.   "Return t if OBJECT is a process-output event."
  85.   (and (event-live-p object) (eq 'process (event-type object))))
  86.  
  87. (defun timeout-event-p (object)
  88.   "Return t if OBJECT is a timeout event."
  89.   (and (event-live-p object) (eq 'timeout (event-type object))))
  90.  
  91. (defun eval-event-p (object)
  92.   "Return t if OBJECT is an eval event."
  93.   (and (event-live-p object) (eq 'eval (event-type object))))
  94.  
  95. (defun misc-user-event-p (object)
  96.   "Return t if OBJECT is a misc-user event.
  97. A misc-user event is a user event that is not a keypress or mouse click;
  98. normally this means a menu selection or scrollbar action."
  99.   (and (event-live-p object) (eq 'misc-user (event-type object))))
  100.  
  101. ;; You could just as easily use event-glyph but we include this for
  102. ;; consistency.
  103.  
  104. (defun event-over-glyph-p (object)
  105.   "Return t if OBJECT is a mouse event occurring over a glyph.
  106. Mouse events are events of type button-press, button-release or motion."
  107.   (and (event-live-p object) (event-glyph object) t))
  108.  
  109. (defun keyboard-translate (&rest pairs)
  110.   "Translate character or keysym FROM to TO at a low level.
  111. Multiple FROM-TO pairs may be specified.
  112.  
  113. See `keyboard-translate-table' for more information."
  114.   (while pairs
  115.     (puthash (pop pairs) (pop pairs) keyboard-translate-table)))
  116.  
  117. (put 'backspace 'ascii-character ?\b)
  118. (put 'delete    'ascii-character ?\177)
  119. (put 'tab       'ascii-character ?\t)
  120. (put 'linefeed  'ascii-character ?\n)
  121. (put 'clear     'ascii-character 12)
  122. (put 'return    'ascii-character ?\r)
  123. (put 'escape    'ascii-character ?\e)
  124. (put 'space    'ascii-character ? )
  125.  
  126.  ;; Do the same voodoo for the keypad keys.  I used to bind these to keyboard
  127.  ;; macros (for instance, kp-0 was bound to "0") so that they would track the
  128.  ;; bindings of the corresponding keys by default, but that made the display
  129.  ;; of M-x describe-bindings much harder to read, so now we'll just bind them
  130.  ;; to self-insert by default.  Not a big difference...
  131.  
  132. (put 'kp-0 'ascii-character ?0)
  133. (put 'kp-1 'ascii-character ?1)
  134. (put 'kp-2 'ascii-character ?2)
  135. (put 'kp-3 'ascii-character ?3)
  136. (put 'kp-4 'ascii-character ?4)
  137. (put 'kp-5 'ascii-character ?5)
  138. (put 'kp-6 'ascii-character ?6)
  139. (put 'kp-7 'ascii-character ?7)
  140. (put 'kp-8 'ascii-character ?8)
  141. (put 'kp-9 'ascii-character ?9)
  142.  
  143. (put 'kp-space     'ascii-character ? )
  144. (put 'kp-tab       'ascii-character ?\t)
  145. (put 'kp-enter     'ascii-character ?\r)
  146. (put 'kp-equal     'ascii-character ?=)
  147. (put 'kp-multiply  'ascii-character ?*)
  148. (put 'kp-add       'ascii-character ?+)
  149. (put 'kp-separator 'ascii-character ?,)
  150. (put 'kp-subtract  'ascii-character ?-)
  151. (put 'kp-decimal   'ascii-character ?.)
  152. (put 'kp-divide    'ascii-character ?/)
  153.  
  154. ;;; events.el ends here
  155.